home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / os2 / ftree11a.zip / FULLDUMP.FTX < prev    next >
Text File  |  1996-10-30  |  10KB  |  282 lines
  1. /*
  2.    Family Tree Rexx Script FTX
  3.  
  4.    Copyright (C) 1996 by <Peter Gervai>
  5.  
  6.    Please send comments to
  7.    Grin at 2:370/15@fidonet or grin@lifeforce.fido.hu
  8.  
  9.    <
  10.    English:   Prints full tree based on descendant subtrees into Spreadsheet
  11.               (something-delimited; default is comma) data file.                       :English
  12.    Deutsch:   Gibt den vollständigen Stammbaum, basierend auf den Teilbäumen
  13.               der Nachfahren, in eine Tabelle aus (Trennzeichen ist Komma).            :Deutsch
  14.    Nederlands:Prints full tree based on descendant subtrees into Spreadsheet
  15.               (something-delimited; default is comma) data file.                       :Nederlands
  16.    Francais:  Imprime la totalité de l'arbre basée sur les ramifications descendantes. :Francais
  17.    >
  18.  
  19.    Well, I use this one to create sheets for relatives far away
  20.    from me and computers, to fill out the gaps... :)
  21.  
  22.    Long name is <
  23.                  English:    Dump of the tree                 :English
  24.                  Deutsch:    Unformatierte Ausgabe des Baumes :Deutsch
  25.                  Nederlands: Dump of the tree                 :Nederlands
  26.                  Francais:   Imprime totalité de l'arbre      :Francais
  27.                 >
  28. */
  29.  
  30. /*
  31.  * Global variables (for EXPOSE in procedures)
  32.  */
  33. globals = 'LANG msg. cr person. dlt'
  34. cr = '0a'x
  35. dlt = ','
  36. person. = 0                             /* array of already printed persons */
  37.  
  38. call InitLanguage
  39.  
  40. /*
  41.  * start
  42.  */
  43. title = msg.Header.LANG getName()',' getFirstName()
  44.  
  45. say title
  46. say copies('=',length(title))
  47. say msg.Row.LANG
  48.  
  49. loop. = 1
  50.  
  51. call SelectPerson('F')
  52.  
  53. do while loop.1
  54.   call DoStack('PP')
  55.   loop.found = SearchForAdam()
  56.  
  57.     /* print nonprinted adam and his subtree */
  58.   if loop.found then do
  59.     call DoStack('PP')                            /* push for emitPerson! */
  60.     call DEmitPerson 1
  61.   end
  62.  
  63.   call DoStack('pP')                              /* original person */
  64.  
  65.   /* search for the next person who have unprocessed subtree */
  66.   do until (person.pid=0) | res=0
  67.     res = SelectPerson('N')
  68.     pid = getPID()
  69.   end
  70.   loop.1 = res                                    /* ...and finish if we're out of persons */
  71. end
  72.  
  73.  
  74. say msg.Finish.LANG
  75.  
  76. /*
  77. do i=1 until \person.i
  78.   i = i + 1
  79. end
  80. say 'CHECK: sequentially listed' i-1 'persons.'
  81. */
  82.  
  83. return 0
  84.  
  85. /*
  86.  * recursive function to travel through subtrees
  87.  */
  88. DEmitPerson: procedure expose (globals); parse arg level
  89.   /* pull actual person */
  90.   if DoStack('pP')=0 then perror(msg.Error.LANG)
  91.  
  92.   pid = getPID()
  93.   if person.pid then return                       /* skip already used subtree */
  94.  
  95.   call OutputPerson1 level                        /* the guy */
  96.   de.guy = str1                                   /* keep for 2nd and more wife */
  97.  
  98.   de.count = 1
  99.   /* check families */
  100.   res = SelectFamily(de.count)
  101.   do while res\=0
  102.   /* print wife */
  103.     call DoStack('PP')
  104.     res = SelectPerson('p')
  105.  
  106.     if de.count\=1 then do
  107.       call charout ,'('level')'||dlt||de.guy      /* at wife #n */
  108.     end
  109.     call OutputPerson2 level                      /* wife */
  110.  
  111.     call DoStack('pP')
  112.  
  113.     /* examine children */
  114.     call DoStack('PP')                            /* original person */
  115.     de.childcount = 1
  116.     res = SelectPerson(de.childcount)
  117.     do while res\=0
  118.     /* print children's tree */
  119.       call DoStack('PF')                          /* save family because SelectPerson(<count>) needs it! */
  120.       call DoStack('PP')                          /* push child for recursion (routine pops it) */
  121.       call DEmitPerson level+1                    /* print child's tree (indent1) */
  122.  
  123.       de.childcount = de.childcount + 1
  124.       call DoStack('pF')                          /* original family */
  125.       res = SelectPerson(de.childcount)           /* get his next child */
  126.     end
  127.  
  128.     call DoStack('pP')                            /* original person */
  129.     de.count = de.count + 1                       /* next family */
  130.     res = SelectFamily(de.count)
  131.   end
  132.   if de.count=1 then
  133.     call charout ,cr                            /* cr after wifeless guys
  134. */
  135. return
  136.  
  137. /*
  138.  * Print personal data
  139.  */
  140. OutputPerson: parse arg lvl
  141.   str1 = ''
  142.   pid = getPID()
  143.   if person.pid then str1 = '*'
  144.   person.pid = 1
  145.  
  146.   str1 = str1 || Translate(getName(),' ',dlt)||dlt
  147.   str1 = str1 || Translate(getFirstName(),' ',dlt)||dlt
  148.   str1 = str1 || WORD(msg.Sex.LANG,getSex()+1)||dlt
  149.   str1 = str1 || getBirthDate()||dlt
  150.   str1 = str1 || Translate(getBirthPlace(),' ',dlt)||dlt
  151.   str1 = str1 || getDeathDate()||dlt
  152.   str1 = str1 || Translate(getDeathPlace(),' ',dlt)||dlt
  153.  
  154.   memofield = translate(getMemo(),';',dlt||'0d0a'x)
  155.   str1 = str1 || memofield||dlt
  156.  
  157.   call charout ,str1
  158.  
  159.   drop lvl
  160. return
  161.  
  162. /* husband */
  163. OutputPerson1: parse arg lvl
  164.   call charout ,lvl||dlt
  165.   call OutputPerson
  166.   drop lvl
  167. return
  168.  
  169. /* wife */
  170. OutputPerson2: parse arg lvl
  171.   call OutputMarriage
  172.   call OutputPerson lvl
  173.   call charout ,cr
  174.  
  175.   drop lvl
  176. return
  177.  
  178. /* marriage */
  179. OutputMarriage:
  180.   call charout ,getMarriageDate()||dlt
  181.   call charout ,Translate(getMarriagePlace(),' ',dlt)||dlt
  182.   call charout ,getDivorceDate()||dlt
  183. return
  184.  
  185. /*
  186.  * Search for oldest ancestor up the tree
  187.  *
  188.  *   return:
  189.  *      1: if found someone not already used, and
  190.  *       SELECTED actual person if there's no ancestor, or
  191.  *       SELECTED the oldest ancestor person
  192.  *      0: if all ancestors and the actual person was already used
  193.  */
  194. SearchForAdam: procedure expose (globals)
  195.   call DoStack('PP')
  196.   res = SelectFamily('p')                         /* select parental family */
  197.   if res\=0 then do
  198.     res = SelectPerson('p')                       /* select a parent */
  199.     res = SearchForAdam()                         /* search for his ancestors */
  200.     if res then do                                /* found */
  201.       call DoStack('DP')                          /* drop original (Peter now 'DROP' is in there :)) */
  202.       return 1
  203.     end
  204.     res = SelectPerson('p')                       /* select other parent */
  205.     res = SearchForAdam()
  206.     if res then do                                /* found */
  207.       call DoStack('DP')                          /* drop original (Peter now 'DROP' is in there :)) */
  208.       return 1
  209.     end
  210.   end
  211.  
  212.   call DoStack('pP')                              /* get original person */
  213.   pid = getPID()
  214.   if person.pid then                              /* if he's already used up */
  215.     return 0                                      /* fail */
  216.   else
  217.     return 1                                      /* ok, person unused */
  218. return 0
  219.  
  220.  
  221. /* ---------------------- LANGUAGE INIT --------------------------- */
  222. InitLanguage:
  223.  
  224.    /* Calculate Language Index */
  225.    lang='E'                              /* Default -> [E]nglish */
  226.    IF getLanguage()='Deutsch' THEN       /* Deutsch -> [G]erman */
  227.       lang='G'
  228.    IF getLanguage()='Nederlands' THEN    /* Nederlands -> [D]utch */
  229.       lang='D'
  230.    IF getLanguage()='Francais' THEN      /* Francais -> [F]rench */
  231.       lang='F'
  232.  
  233.    /* [E]nglish Messages */
  234.    msg.Header.E = 'Full Tree based on descendant subtrees'
  235.    msg.Sex.E    = 'N/A Male Female'
  236.    msg.Row.E    = 'Lvl'||dlt||'Name'||dlt||dlt||'Sex'||dlt||'Born'||dlt||,
  237.                   'BPlace'||dlt||'Died'||dlt||'DPlace'||dlt||'Comment'||dlt||,
  238.                   'Married'||dlt||'MPlace'||dlt||dlt,
  239.                   'Partner name'||dlt||dlt||'Sex'||dlt||'Born'||dlt||,
  240.                   'BPlace'||dlt||'Died'||dlt||'DPlace'||dlt||'Comment'
  241.    msg.Error.E  = 'Error popping from stack!'
  242.    msg.Finish.E = '===Finished==='
  243.  
  244.    /* [G]erman Messages */
  245.    msg.Header.G = 'Vollständiger Baum basierend auf Teilbäume der Nachfahren'
  246.    msg.Sex.G    = 'N/A Männlich Weiblich'
  247.    msg.Row.G    = 'Lvl'||dlt||'Name'||dlt||dlt||'Geschlecht'||dlt||'Geboren'||dlt||,
  248.                   'GebOrt'||dlt||'Gestorben'||dlt||'GesOrt'||dlt||'Kommentar'||dlt||,
  249.                   'Verheiratet'||dlt||'VerOrd'||dlt||dlt,
  250.                   'Name d.Partners'||dlt||dlt||'Geschlecht'||dlt||'Geboren'||dlt||,
  251.                   'GebOrt'||dlt||'Gestorben'||dlt||'GesOrt'||dlt||'Kommentar'
  252.    msg.Error.G  = 'Fehler beim Pop von Person von Stack!'
  253.    msg.Finish.G = '===Beendet==='
  254.  
  255.    /* [D]utch Messages */
  256.    msg.Header.D = 'Full Tree based on descendant subtrees'
  257.    msg.Sex.D    = 'N/A Male Female'
  258.    msg.Row.D    = 'Lvl'||dlt||'Name'||dlt||dlt||'Sex'||dlt||'Born'||dlt||,
  259.                   'BPlace'||dlt||'Died'||dlt||'DPlace'||dlt||'Comment'||dlt||,
  260.                   'Married'||dlt||'MPlace'||dlt||dlt,
  261.                   'Partner name'||dlt||dlt||'Sex'||dlt||'Born'||dlt||,
  262.                   'BPlace'||dlt||'Died'||dlt||'DPlace'||dlt||'Comment'
  263.    msg.Error.D  = 'Error popping from stack!'
  264.    msg.Finish.D = '===Finished==='
  265.  
  266.    /* [F]rench Messages */
  267.    msg.Header.F = "Arbre Complet basé sur les arborescences descendantes"
  268.    msg.Sex.F    = "N/A Homme Femme"
  269.    msg.Row.F    = "Lvl"||dlt||"Nom"||dlt||dlt||"Sexe"||dlt||"Né(e)"||dlt||,
  270.                   "LieuNais"||dlt||"Décédé(e)"||dlt||"LieuDéc"||dlt||"Commentaire"||dlt||,
  271.                   "Marié(e)"||dlt||"LieuMar"||dlt||dlt,
  272.                   "Nom du Conjoint"||dlt||dlt||"Sexe"||dlt||"Né(e)"||dlt||,
  273.                   "LieuNais"||dlt||"Décédé(e)"||dlt||"LieuDéc"||dlt||"Commentaire"
  274.    msg.Error.F  = "Erreur survenant de la pile!"
  275.    msg.Finish.F = "===Terminé==="
  276.  
  277.    /* Done */
  278.    RETURN
  279.  
  280.  
  281.  
  282.